home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / pulldwn.arc / WINDOW31.INC < prev   
Encoding:
Text File  |  1987-01-24  |  10.1 KB  |  227 lines
  1. { Window31.inc - Multi-level windowing routines             ver 3.1, 01-24-87 }
  2. {                                                                             }
  3. { This file allows you to produce quick multi-level windows for IBM PC/XT/AT  }
  4. { compatibles in any column mode (40/80/etc.).  You should get a copy of      }
  5. { QWIK21.ARC or a later version to make full use of quick screen writing      }
  6. { utilites.  This file has been released under the free Teamware concept.     }
  7. {   Editor:   Jim H. LeMay     (Author of QWIK21.INC and editor of this file) }
  8. {   Author:   Michael Burton   (Original author of WINDO.INC version 2.3)     }
  9.  
  10. type
  11.   Borders = (none, single, double, mixed, solid, diamond, circle,
  12.              Lhatch, Mhatch, Hhatch);
  13.   BrdrRec = record
  14.               TL,TH,TR,LV,RV,BL,BH,BR: string[1];
  15.             end;
  16.   WndwStatType = record
  17.                    Wrow,Wcol,Wrows,Wcols,Wattrib,WBattrib: byte;
  18.                    Wbordr: Borders;
  19.                    Wlastx,Wlasty: byte;
  20.                  end;
  21.   BytePtr = ^byte;
  22.   Str160  = String[160];
  23. (****************************************************************************)
  24. (*                                                                          *)
  25. (*      THE ONLY DIFFERENCE BETWEEN THIS AND WINDOW30.INC IS THE            *)
  26. (*      DEFINITION OF SOLID BELOW.  THE ORIGINAL SOLID DOES NOT             *)
  27. (*      LOOKS GOOD WITH THESE PULLDOWN MENUS (ALTHOUGH IT CAN BE USED)      *)
  28. (****************************************************************************)
  29.  
  30. const MaxWndw = 30;        { Total number of windows on screen at any time }
  31.       brdr: array [none..Hhatch] of BrdrRec =
  32.        ((TL:' ';TH:' ';TR:' ';LV:' ';RV:' ';BL:' ';BH:' ';BR:' '),  { none   }
  33.         (TL:'┌';TH:'─';TR:'┐';LV:'│';RV:'│';BL:'└';BH:'─';BR:'┘'),  { single }
  34.         (TL:'╔';TH:'═';TR:'╗';LV:'║';RV:'║';BL:'╚';BH:'═';BR:'╝'),  { double }
  35.         (TL:'╒';TH:'═';TR:'╕';LV:'│';RV:'│';BL:'╘';BH:'═';BR:'╛'),  { mixed  }
  36.         (TL:'▐';TH:'▀';TR:'▌';LV:'▐';RV:'▌';BL:'▐';BH:'▄';BR:'▌'),  { solid  }
  37.         (TL:#8 ;TH:#8 ;TR:#8 ;LV:#8 ;RV:#8 ;BL:#8 ;BH:#8 ;BR:#8 ),  { diamond}
  38.         (TL:#10;TH:#10;TR:#10;LV:#10;RV:#10;BL:#10;BH:#10;BR:#10),  { circle }
  39.         (TL:'░';TH:'░';TR:'░';LV:'░';RV:'░';BL:'░';BH:'░';BR:'░'),  { Lhatch }
  40.         (TL:'▒';TH:'▒';TR:'▒';LV:'▒';RV:'▒';BL:'▒';BH:'▒';BR:'▒'),  { Mhatch }
  41.         (TL:'▓';TH:'▓';TR:'▓';LV:'▓';RV:'▓';BL:'▓';BH:'▓';BR:'▓')); { Hhatch }
  42.  
  43. var
  44.      WndwStat : Array [0..MaxWndw] of WndwStatType; { window stats         }
  45.      WndwPtr  : Array [1..MaxWndw] of BytePtr; { pointer to window on heap }
  46.      LI   : byte;                            { level index                 }
  47.      Tattr: byte absolute Dseg:$0008;        { Turbo's attribute value     }
  48.      Battr: byte;                            { Border attribute            }
  49.  
  50. { =========================================================================== }
  51. { NAME: Qbox                                               ver 3.0,  01-01-87 }
  52. { DESCRIPTION: Writes a window with optional border.  Since attribute         }
  53. {              is byte, the colors should always be specified.                }
  54. { PARAMETERS:  See QWIK21.DOC                                                 }
  55. { =========================================================================== }
  56. procedure Qbox (Row,Col,Rows,Cols,WndwAttr,BrdrAttr: byte; BrdrSel: Borders);
  57. begin
  58.   if (Rows>=2) and (Cols>=2) then
  59.   begin
  60.     with Brdr[BrdrSel] do
  61.     begin
  62.       QwriteV (Row       ,Col                     ,BrdrAttr,TL);
  63.       Qfill   (Row       ,Col+1     ,1     ,Cols-2,BrdrAttr,TH);
  64.       QwriteV (Row       ,Col+Cols-1              ,BrdrAttr,TR);
  65.       Qfill   (Row+1     ,Col       ,Rows-2,1     ,BrdrAttr,LV);
  66.       Qfill   (Row+1     ,Col+Cols-1,Rows-2,1     ,BrdrAttr,RV);
  67.       QwriteV (Row+Rows-1,Col                     ,BrdrAttr,BL);
  68.       Qfill   (Row+Rows-1,Col+1     ,1     ,Cols-2,BrdrAttr,BH);
  69.       QwriteV (Row+Rows-1,Col+Cols-1              ,BrdrAttr,BR);
  70.       Qfill   (Row+1     ,Col+1     ,Rows-2,Cols-2,WndwAttr,' ')
  71.     end
  72.   end
  73. end;
  74.  
  75. { =========================================================================== }
  76. { NAME: Bleep                                               ver 1.0, 01-12-86 }
  77. { DESCRIPTION: Produces a bleeping sound times number of times                }
  78. { PARAMETERS: Times -  The number of bleeps required                          }
  79. { =========================================================================== }
  80. procedure Bleep (Times: byte);
  81. var i : byte;
  82. begin
  83.    for i := 1 to Times do
  84.    begin
  85.       NoSound;
  86.       Sound (880);
  87.       Delay ( 60);
  88.       Sound (440);
  89.       Delay ( 60);
  90.       NoSound;
  91.    end;
  92. end;
  93.  
  94. { =========================================================================== }
  95. { NAME: InitWindow                                                            }
  96. { DESCRIPTION:  Initializes the window variables.  Use this routine before    }
  97. {               using MakeWindow, RemoveWindow or TitleWindow                 }
  98. { PARAMETERS:                                                                 }
  99. {       TxtColor - Starting text color                                        }
  100. {       TxtBack  - Starting background color                                  }
  101. { =========================================================================== }
  102. procedure InitWindow (TxtColor,TxtBack: byte);
  103. begin
  104.    Qinit;
  105.    TextColor (TxtColor);
  106.    TextBackground (TxtBack);
  107.    with WndwStat[0] do
  108.    begin
  109.      Wrow   := 1;       { Initialize non-window zero }
  110.      Wcol   := 1;
  111.      Wrows   := 25;
  112.      Wcols   := 80;
  113.      Wattrib := Tattr;
  114.      WBattrib := Tattr;
  115.      Wbordr  := none;
  116.      Wlastx  := Wherex;
  117.      Wlasty  := Wherey
  118.    end;
  119.    LI := 0;
  120.    Qfill ( 1, 1,25,80,Tattr,' ');
  121. End;
  122.  
  123. { =========================================================================== }
  124. { NAME: MakeWindow                                          ver 3.0, 01-01-87 }
  125. { DESCRIPTION:  Creates a window on your screen.                              }
  126. { PARAMETERS:                                                                 }
  127. {       Row    - First row        (1 - Screen limit)                          }
  128. {       Col    - First column     (1 - Screen limit)                          }
  129. {       Rows   - # of rows        (1 - Screen limit)                          }
  130. {       Cols   - # of columns     (1 - Screen limit)                          }
  131. {       Tcolor - Text color       (0 - 15)                                    }
  132. {       Tback  - Text background  (0 - 7, > 7 for blinking)                   }
  133. {       Bcolor - Border color     (0 - 15)                                    }
  134. {       Bback  - Border backgrnd  (0 - 7, > 7 for blinking)                   }
  135. {       BrdSel - Border selection (none - Hhatch)                             }
  136. { =========================================================================== }
  137. procedure MakeWindow (Row,Col,Rows,Cols,Tcolor,Tback,Bcolor,Bback: byte;
  138.                                                           BrdrSel: Borders);
  139. var wsize: integer;
  140. begin
  141.    if LI >= MaxWndw then
  142.    begin
  143.       WriteLn('Too many Windows!');
  144.       Bleep(4)
  145.    end
  146.    else
  147.    begin
  148.       wsize := (Rows*Cols) shl 1;    { Memory size needed to store display }
  149.       If (0<memavail) and (memavail<=(wsize shr 4)) then
  150.                       { if memavail<0 then there's plenty of room (>512kb)}
  151.       begin
  152.          WriteLn('Not enough Heap space!');
  153.          Bleep(4);
  154.       end
  155.       else
  156.       begin
  157.          WndwStat[LI].Wlastx  := Wherex;   { Store old cursor coordinates }
  158.          WndwStat[LI].Wlasty  := Wherey;
  159.          LI := LI + 1;        { Go to next window level }
  160.          TextColor (Tcolor);
  161.          TextBackground (Tback);
  162.          Battr:= Bback shl 4 + Bcolor;
  163.          with WndwStat[LI] do
  164.          begin
  165.            Wrow := Row;   { Store all variables for this window }
  166.            Wcol := Col;
  167.            Wrows := Rows;
  168.            Wcols := Cols;
  169.            Wattrib := Tattr;
  170.            Wbordr  := BrdrSel;
  171.            WBattrib := Battr
  172.          end;
  173.          GetMem (WndwPtr[LI],wsize);   { Get enough heap to store old display }
  174.          QstoreToMem (Row,Col,Rows,Cols,WndwPtr[LI]^);
  175.          Qbox (Row,Col,Rows,Cols,Tattr,Battr,BrdrSel);
  176.          if BrdrSel=none then Window (Col,Row,Col+Cols-1,Row+Rows-1)
  177.            else Window (Col+1,Row+1,Col+Cols-2,Row+Rows-2);
  178.          GotoXY (1,1);
  179.       end;
  180.    end;
  181. end;
  182.  
  183. { =========================================================================== }
  184. { NAME: RemoveWindow                                        ver 3.0, 01-01-87 }
  185. { DESCRIPTION: Remove the last window created from the screen.  To            }
  186. {              get back to the original screen, there must be as many         }
  187. {              RemoveWindow(s) as there are MakeWindow(s).                    }
  188. { =========================================================================== }
  189. procedure RemoveWindow;
  190. var wsize: integer;
  191. begin
  192.    if LI = 0 then
  193.    begin
  194.       WriteLn ('No Window To Remove!');
  195.       Bleep (4);
  196.    end
  197.    else
  198.    begin
  199.      with WndwStat[LI] do
  200.      begin
  201.        QstoreToScr (Wrow,Wcol,Wrows,Wcols,WndwPtr[LI]^);
  202.        FreeMem (WndwPtr[LI],Wrows*Wcols shl 1);      { Release heap space }
  203.      end;
  204.      LI := LI - 1;                   { Go to next lower level }
  205.      with WndwStat[LI] do
  206.      begin
  207.        Tattr:= Wattrib;
  208.        if Wbordr = none then Window (Wcol,Wrow,Wcol+Wcols-1,Wrow+Wrows-1)
  209.          else Window (Wcol+1,Wrow+1,Wcol+Wcols-2,Wrow+Wrows-2);
  210.        GotoXY (Wlastx,Wlasty);
  211.      end;
  212.    End;
  213. End;
  214.  
  215. { =========================================================================== }
  216. { NAME: TitleWindow                                         ver 3.0, 01-01-87 }
  217. { DESCRIPTION: Places a centered title in the top border of a window          }
  218. { PARAMETERS:  Title - Optional title of the window                           }
  219. { =========================================================================== }
  220. procedure TitleWindow (title: Str160);
  221. begin
  222.   with WndwStat[LI] do
  223.   begin
  224.     QwriteCV (Wrow,Wcol,Wcol+Wcols-1, -1,title);
  225.   end
  226. end;
  227.